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Demo program for Library access procedures 
Version ‘'v04-000' 
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COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
ALL RIGHTS RESERVED. 


® 

e 

® 

® 

* 

s 

* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
+ ONLY IN ACCORDANCE WITH THE TERMS OF SUCH. LICENSE AND WITH THE 
* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER 
* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY 
* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 
* TRANSFERRED. 

® 

* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE W 
* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGI 
= CORPORATION. 

a 

& 
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* 
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DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


ITHOUT NOTICE 
TAL EQUIPMENT 
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POOOOOAIOAIOIAOAIOAIOOAAIAIAAOAOOOOOOOO 


PROGRAM LBR_DEMO 


IMPLICIT INTEGER (AZ) 
EXTERNAL Lib$get_input, List_module, lbr$_illcreopt 


The common block is declared in a MACRO source module to gain 
access to system definitions not available to FORTRAN. 


COOOL 


— /\brdata/ func_read, func_create, func_update, 
type. text, type_help, rmseof, Class dynamic, create_type, 
; create_keylen, Create_alloc, create_idxmax, create_Uhdmax, 
create_entall 


CHARACTER*128 Library_name, Library_rsn, module_name 
CHARACTER*128 input_line 


BYTE help_namblk (56), string_desc_bytes (8), dyn_desc_bytes (8) 
DIMENSION create_options (0:49), old_module_rfa (2), module_rfa (2), 
1 dyn_string (2); string_desc (2) 
The equivalence of the STRING_DESC array with the taf DESC_BYTES 
array is done to access the string descriptor class field. 


EQUIVALENCE (string_desc, string_desc_bytes), 
1 (dyn_string, dyn_desc _bytes) 


OOOL# 


library_open = .false. 
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DOO MOON 


10 


OOO 


100 


200 


OOo 


300 


C 
C 
C 
C 
C 
C 


2000 


have_name = .false. 
Initialize NAM block for use with HELP Library 
CALL nam_init (help_namblk, Library _rsn) 
Allocate a dynamic string and initialize string descriptors 
dyn_string (1) = 8 
dyn_ “3tcing (2) = ; 
~ “desc ytes, (4) = class dynamic 
ring. desc ¢ 
string: desc (3) = 
string. desc pe (4) = class_dynamic 
i (1 eti_dd C2088. string_desc) ‘Allocate 2048 byte string 
IF (status)~GOTO 100 
CALL Lib$signal (ZVAL (status)) 
STOP 
Main dispatch loop -- Get action and dispatch 
hia " 0. 
ND=300) a 
af (7600, 000, 3000, 1800, 5000, 6000, 7000), action + 1 


CALL Lib$signal (Z%VAL (status)) 
GOTO 100 


Close Library and exit 

IF (Library open) THEN 
status = lbr$close (Library_index) 
eget status) GOTO 10 


STOP 


Give some help 
TYPE 9020 

GOTO 100 

Name new Library 


If there is a Library open, it will be closed. The new library name 
is accepted. 


IF (Library_open) THEN 
status = lbr$close (Library. index) 
IF (.NOT. status) CALL Lib$SSignal (ZVAL (status)) 
Library. open = .false. 


READ 5 tS 9110, END=100) name Length, Library_name 
Library. name = Library_name T1:name_length)/7'.TLB' 
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C 
C 
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OOO 


FQOOO OOo 


Oona 


3000 


3100 


4000 


4100 


4120 


A 
4 


have_name = .true. 
GOTO 100 


Open or Create a TEXT Library 
IF (.NOT. have_name) GOTO 8000 
TYPE 9540 


READ (5, *, END = 100) create_flag 
IF (create flag) THEN 
TYPE 9 


READ (5, *, END=100) max_key_length 

function = func_create 

create_options (create_type) = type_text 
create_options (create_keylen) = max_key_length 
create_options (create_alloc) = 100 
create_options (create_idxmax) 
create_options (create_uhdmax) 
srepte_epttens (create_entall) 


0 
100 
yd a = func_update 'Opening existing Library. Set for updates 


Initialize librarian for this Library 


status = lbrS$ini_control (Library_index, function, type_text) 
IF (.NOT. status) GOTO 200 


Open or create the Library 
status = lbrSopen (library_index, Library_name, create_options) 


If there is an illegal create_option then it must be the value for the 
maximum key length, so repromt. 


IF (status .EQ. ZLOC (lbr$_illcreopt)) THEN 
CALL Lib$signal (lbr$_illcreopt) 
GOTO 3100 


IF (.NOT. status) GOTO 200 
5 terete open = .TRUE. 
GOTO 100 


Insert or replace a module in the text Library 
if Mol, Library_open) GOTO 8020 

READ (5, 9110, END=100) name_length, module_name 
replacing = lor$lookup_key (Tibrary. index, 

1 module name (1:name_Tength), old_module_rfa) 


TYPE 

READ (5, 9110, END = 4200) bine, Length. input_line 
ptetes = Lbr$put_record (library_index 

I 


'Determine if replacing or inserting module 


input_line (1:Tine_length), module rfa) 
F (.NOT. status) CACL Lib$signal (Z0AL (status)? 
GOTO 4100 


OOo 


4200 


eon 


5000 


5100 


OOan 


6000 


AOL 


7000 


CGO Aon 
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Module text has been inserted into the Library. Terminate the module 


status = lbrS$put_end (Library_index) 

IF (.NOT. status) CALL Libss {gnal index (status)) 

status = Lbr$re lace kes (Ll eWie's — ‘Insert or replace key 
module_name (1:name_len tn e_rfa, peeve, rfa) 

IF (NOT; status) CALC Lib$signal fog (Status)) 

status = . TRUE. 

if ld podulerrtes status = lbr$delete_data (library_index, !If replacing, delete old module 
old_modu 

IF (.AOT. seScuns GOTO 200 

GOTO 100 


Extract module from Library and type on terminal 
IF (.NOT. Library_open) GOTO 8020 
TYPE 9400 


READ (5, 9050, END = 100) module_name 

status = lbr$ lookup. ke key. (Library_index, module_name, module_rfa) 
IF (.NOT. status) 200 

eretys a apts ae sacar (Library_index, string. desc, dyn_string) 
IF ((.NOT. statuS) .AND. status .NE. rmseof) 

1 CALL L185 ignal (ZVAL (status)) 

IF (status .EQ. rmseof) GOTO 100 

CALL j {bsput output (dyn_string) 

GOTO 5100 


List contents of index of SYSSHELP:HELPLIB.HLB 


status = lbr$ini centres (help_index, func _read, type_help) 
IF (.NOT. status) GOTO 20 

status = lbr$open thetp index, ZDESCR (*SYSS$HELP:HELPLIB.HLB')) 
If (.NOT. status) GOTO 200 

status = lbr$get_index (help_index, 1, lList_module) 

IF (.NOT. status) CALL LibssTgnal (2VAL (status)) 

status = lbr$close (help index) 

If (.NOT. status) GOTO 200 

GOTO 100 


ae help text in SYSSHELP:HELPLIB.HLB and display on the terminal 
READ aioe 9110, ~—* 100) Line_length, input_line 

status = Lbr$ou tput help tt ioSbut Output, . Tnput_line (1:line_length), 
1 ZDESCR (' HELPL B'y, , Lib Sget put 

IF (.NOT. status) CALL’ Lib$s ons REVAL (status)) 

GOTO 100 


Error routines 


No Library name given 
TYPE 9500 
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GOTO 100 
No Library open 


TYPE 9520 
GOTO 100 


Format statements 


FORMAT (* Action (0 for help): ',$) 

FORMAT (* Commands:',/* 1 = Name Library',/, 

1° 2 = Open or Create a text Library',/, 

2' 3 = Replace/insert module',/, 

4' 4 = Extract module',/, 

5 = List directory of SYSSHELP:HELPLIB.HLB',/ 
5" 6 = Lookup help text in SYS$HELP:HELPLIB.HLB'S 
FORMAT da, ee library name: ',$) 


A 
FORMAT (* Maximum key ak yes ',$) 
FORMAT (° Module name: ',$) 

FORMAT be naper text. Terminate with a Control-Z:') 


T (Q, 
FORMAT (* Enter help keys: ',$) 
FORMAT (* Module to extract: ',$) 
FORMAT (* No Library mame given') 
foRAAT (" No Library open’ 


A 
ay Open existing Library (0) or create new Library (1): ',$) 


INTEGER FUNCTION List_module (keyname, keyrfa) 
IMPLICIT INTEGER (A-Z) 
CHARACTER *(*) keyname 
TYPE a pny 


List_modu 


. true, 'Return success 
RETURN 
END 
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